home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / share / multimed / myflix_win32 / myflix_win32.exe / data1.cab / Libraries / tk8.0 / Clrpick.tcl < prev    next >
Text File  |  1998-03-10  |  20KB  |  692 lines
  1. # clrpick.tcl --
  2. #
  3. #    Color selection dialog for platforms that do not support a
  4. #    standard color selection dialog.
  5. #
  6. # SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
  7. #
  8. # Copyright (c) 1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # ToDo:
  14. #
  15. #    (1): Find out how many free colors are left in the colormap and
  16. #         don't allocate too many colors.
  17. #    (2): Implement HSV color selection. 
  18. #
  19.  
  20. # tkColorDialog --
  21. #
  22. #    Create a color dialog and let the user choose a color. This function
  23. #    should not be called directly. It is called by the tk_chooseColor
  24. #    function when a native color selector widget does not exist
  25. #
  26. proc tkColorDialog {args} {
  27.     global tkPriv
  28.     set w .__tk__color
  29.     upvar #0 $w data
  30.  
  31.     # The lines variables track the start and end indices of the line
  32.     # elements in the colorbar canvases.
  33.     set data(lines,red,start)   0
  34.     set data(lines,red,last)   -1
  35.     set data(lines,green,start) 0
  36.     set data(lines,green,last) -1
  37.     set data(lines,blue,start)  0
  38.     set data(lines,blue,last)  -1
  39.  
  40.     # This is the actual number of lines that are drawn in each color strip.
  41.     # Note that the bars may be of any width.
  42.     # However, NUM_COLORBARS must be a number that evenly divides 256.
  43.     # Such as 256, 128, 64, etc.
  44.     set data(NUM_COLORBARS) 8
  45.  
  46.     # BARS_WIDTH is the number of pixels wide the color bar portion of the
  47.     # canvas is. This number must be a multiple of NUM_COLORBARS
  48.     set data(BARS_WIDTH) 128
  49.  
  50.     # PLGN_WIDTH is the number of pixels wide of the triangular selection
  51.     # polygon. This also results in the definition of the padding on the 
  52.     # left and right sides which is half of PLGN_WIDTH. Make this number even.
  53.     set data(PLGN_HEIGHT) 10
  54.  
  55.     # PLGN_HEIGHT is the height of the selection polygon and the height of the 
  56.     # selection rectangle at the bottom of the color bar. No restrictions.
  57.     set data(PLGN_WIDTH) 10
  58.  
  59.     tkColorDialog_Config $w $args
  60.     tkColorDialog_InitValues $w
  61.  
  62.     if ![winfo exists $w] {
  63.     toplevel $w -class tkColorDialog
  64.     tkColorDialog_BuildDialog $w
  65.     }
  66.     wm transient $w $data(-parent)
  67.  
  68.  
  69.     # 5. Withdraw the window, then update all the geometry information
  70.     # so we know how big it wants to be, then center the window in the
  71.     # display and de-iconify it.
  72.  
  73.     wm withdraw $w
  74.     update idletasks
  75.     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  76.     - [winfo vrootx [winfo parent $w]]]
  77.     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  78.     - [winfo vrooty [winfo parent $w]]]
  79.     wm geom $w +$x+$y
  80.     wm deiconify $w
  81.     wm title $w $data(-title)
  82.  
  83.     # 6. Set a grab and claim the focus too.
  84.  
  85.     set oldFocus [focus]
  86.     set oldGrab [grab current $w]
  87.     if {$oldGrab != ""} {
  88.     set grabStatus [grab status $oldGrab]
  89.     }
  90.     grab $w
  91.     focus $data(okBtn)
  92.  
  93.     # 7. Wait for the user to respond, then restore the focus and
  94.     # return the index of the selected button.  Restore the focus
  95.     # before deleting the window, since otherwise the window manager
  96.     # may take the focus away so we can't redirect it.  Finally,
  97.     # restore any grab that was in effect.
  98.  
  99.     tkwait variable tkPriv(selectColor)
  100.     catch {focus $oldFocus}
  101.     grab release $w
  102.     destroy $w
  103.     unset data
  104.     if {$oldGrab != ""} {
  105.     if {$grabStatus == "global"} {
  106.         grab -global $oldGrab
  107.     } else {
  108.         grab $oldGrab
  109.     }
  110.     }
  111.     return $tkPriv(selectColor)
  112. }
  113.  
  114. # tkColorDialog_InitValues --
  115. #
  116. #    Get called during initialization or when user resets NUM_COLORBARS
  117. #
  118. proc tkColorDialog_InitValues {w} {
  119.     upvar #0 $w data
  120.  
  121.     # IntensityIncr is the difference in color intensity between a colorbar
  122.     # and its neighbors.
  123.     set data(intensityIncr) [expr 256 / $data(NUM_COLORBARS)]
  124.  
  125.     # ColorbarWidth is the width of each colorbar
  126.     set data(colorbarWidth) \
  127.     [expr $data(BARS_WIDTH) / $data(NUM_COLORBARS)]
  128.  
  129.     # Indent is the width of the space at the left and right side of the
  130.     # colorbar. It is always half the selector polygon width, because the
  131.     # polygon extends into the space.
  132.     set data(indent) [expr $data(PLGN_WIDTH) / 2]
  133.  
  134.     set data(colorPad) 2
  135.     set data(selPad)   [expr $data(PLGN_WIDTH) / 2]
  136.  
  137.     #
  138.     # minX is the x coordinate of the first colorbar
  139.     #
  140.     set data(minX) $data(indent)
  141.  
  142.     #
  143.     # maxX is the x coordinate of the last colorbar
  144.     #
  145.     set data(maxX) [expr $data(BARS_WIDTH) + $data(indent)-1]
  146.  
  147.     #
  148.     # canvasWidth is the width of the entire canvas, including the indents
  149.     #
  150.     set data(canvasWidth) [expr $data(BARS_WIDTH) + \
  151.     $data(PLGN_WIDTH)]
  152.  
  153.     # Set the initial color, specified by -initialcolor, or the
  154.     # color chosen by the user the last time.
  155.     set data(selection) $data(-initialcolor)
  156.     set data(finalColor)  $data(-initialcolor)
  157.     set rgb [winfo rgb . $data(selection)]
  158.  
  159.     set data(red,intensity)   [expr [lindex $rgb 0]/0x100]
  160.     set data(green,intensity) [expr [lindex $rgb 1]/0x100]
  161.     set data(blue,intensity)  [expr [lindex $rgb 2]/0x100]
  162. }
  163.  
  164. # tkColorDialog_Config  --
  165. #
  166. #    Parses the command line arguments to tk_chooseColor
  167. #
  168. proc tkColorDialog_Config {w argList} {
  169.     global tkPriv
  170.     upvar #0 $w data
  171.  
  172.     # 1: the configuration specs
  173.     #
  174.     set specs {
  175.     {-initialcolor "" "" ""}
  176.     {-parent "" "" "."}
  177.     {-title "" "" "Color"}
  178.     }
  179.  
  180.     # 2: parse the arguments
  181.     #
  182.     tclParseConfigSpec $w $specs "" $argList
  183.  
  184.     if ![string compare $data(-title) ""] {
  185.     set data(-title) " "
  186.     }
  187.     if ![string compare $data(-initialcolor) ""] {
  188.     if {[info exists tkPriv(selectColor)] && \
  189.         [string compare $tkPriv(selectColor) ""]} {
  190.         set data(-initialcolor) $tkPriv(selectColor)
  191.     } else {
  192.         set data(-initialcolor) [. cget -background]
  193.     }
  194.     } else {
  195.     if [catch {winfo rgb . $data(-initialcolor)} err] {
  196.         error $err
  197.     }
  198.     }
  199.  
  200.     if ![winfo exists $data(-parent)] {
  201.     error "bad window path name \"$data(-parent)\""
  202.     }
  203. }
  204.  
  205. # tkColorDialog_BuildDialog --
  206. #
  207. #    Build the dialog.
  208. #
  209. proc tkColorDialog_BuildDialog {w} {
  210.     upvar #0 $w data
  211.  
  212.     # TopFrame contains the color strips and the color selection
  213.     #
  214.     set topFrame [frame $w.top -relief raised -bd 1]
  215.  
  216.     # StripsFrame contains the colorstrips and the individual RGB entries
  217.     set stripsFrame [frame $topFrame.colorStrip]
  218.  
  219.     foreach c { Red Green Blue } {
  220.     set color [string tolower $c]
  221.  
  222.     # each f frame contains an [R|G|B] entry and the equiv. color strip.
  223.     set f [frame $stripsFrame.$color]
  224.  
  225.     # The box frame contains the label and entry widget for an [R|G|B]
  226.     set box [frame $f.box]
  227.  
  228.     label $box.label -text $c: -width 6 -under 0 -anchor ne
  229.     entry $box.entry -textvariable [format %s $w]($color,intensity) \
  230.         -width 4
  231.     pack $box.label -side left -fill y -padx 2 -pady 3
  232.     pack $box.entry -side left -anchor n -pady 0
  233.     pack $box -side left -fill both
  234.  
  235.     set height [expr \
  236.         [winfo reqheight $box.entry] - \
  237.         2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])]
  238.  
  239.     canvas $f.color -height $height\
  240.         -width $data(BARS_WIDTH) -relief sunken -bd 2
  241.     canvas $f.sel -height $data(PLGN_HEIGHT) \
  242.         -width $data(canvasWidth) -highlightthickness 0
  243.     pack $f.color -expand yes -fill both
  244.     pack $f.sel -expand yes -fill both
  245.  
  246.     pack $f -side top -fill x -padx 0 -pady 2
  247.  
  248.     set data($color,entry) $box.entry
  249.     set data($color,col) $f.color
  250.     set data($color,sel) $f.sel
  251.  
  252.     bind $data($color,col) <Configure> \
  253.         "tkColorDialog_DrawColorScale $w $color 1"
  254.     bind $data($color,col) <Enter> \
  255.         "tkColorDialog_EnterColorBar $w $color"
  256.     bind $data($color,col) <Leave> \
  257.         "tkColorDialog_LeaveColorBar $w $color"
  258.  
  259.     bind $data($color,sel) <Enter> \
  260.         "tkColorDialog_EnterColorBar $w $color"
  261.     bind $data($color,sel) <Leave> \
  262.         "tkColorDialog_LeaveColorBar $w $color"
  263.     
  264.     bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
  265.     }
  266.  
  267.     pack $stripsFrame -side left -fill both -padx 4 -pady 10
  268.  
  269.     # The selFrame contains a frame that demonstrates the currently
  270.     # selected color
  271.     #
  272.     set selFrame [frame $topFrame.sel]
  273.     set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
  274.     set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
  275.     -width 16]
  276.     set f1  [frame $selFrame.f1 -relief sunken -bd 2]
  277.     set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
  278.  
  279.     pack $lab $ent -side top -fill x -padx 4 -pady 2
  280.     pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
  281.     pack $data(finalCanvas) -expand yes -fill both
  282.  
  283.     bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
  284.  
  285.     pack $selFrame -side left -fill none -anchor nw
  286.     pack $topFrame -side top -expand yes -fill both -anchor nw
  287.  
  288.     # the botFrame frame contains the buttons
  289.     #
  290.     set botFrame [frame $w.bot -relief raised -bd 1]
  291.     button $botFrame.ok     -text OK            -width 8 -under 0 \
  292.     -command "tkColorDialog_OkCmd $w"
  293.     button $botFrame.cancel -text Cancel        -width 8 -under 0 \
  294.     -command "tkColorDialog_CancelCmd $w"
  295.  
  296.     set data(okBtn)      $botFrame.ok
  297.     set data(cancelBtn)  $botFrame.cancel
  298.  
  299.     pack $botFrame.ok $botFrame.cancel \
  300.     -padx 10 -pady 10 -expand yes -side left
  301.     pack $botFrame -side bottom -fill x
  302.  
  303.  
  304.     # Accelerator bindings
  305.  
  306.     bind $w <Alt-r> "focus $data(red,entry)"
  307.     bind $w <Alt-g> "focus $data(green,entry)"
  308.     bind $w <Alt-b> "focus $data(blue,entry)"
  309.     bind $w <Alt-s> "focus $ent"
  310.     bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
  311.     bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
  312.     bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
  313.  
  314.     wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
  315. }
  316.  
  317. # tkColorDialog_SetRGBValue --
  318. #
  319. #    Sets the current selection of the dialog box
  320. #
  321. proc tkColorDialog_SetRGBValue {w color} {
  322.     upvar #0 $w data 
  323.  
  324.     set data(red,intensity)   [lindex $color 0]
  325.     set data(green,intensity) [lindex $color 1]
  326.     set data(blue,intensity)  [lindex $color 2]
  327.     
  328.     tkColorDialog_RedrawColorBars $w all
  329.  
  330.     # Now compute the new x value of each colorbars pointer polygon
  331.     foreach color { red green blue } {
  332.     set x [tkColorDialog_RgbToX $w $data($color,intensity)]
  333.     tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
  334.     }
  335. }
  336.  
  337. # tkColorDialog_XToRgb --
  338. #
  339. #    Converts a screen coordinate to intensity
  340. #
  341. proc tkColorDialog_XToRgb {w x} {
  342.     upvar #0 $w data
  343.     
  344.     return [expr ($x * $data(intensityIncr))/ $data(colorbarWidth)]
  345. }
  346.  
  347. # tkColorDialog_RgbToX
  348. #
  349. #    Converts an intensity to screen coordinate.
  350. #
  351. proc tkColorDialog_RgbToX {w color} {
  352.     upvar #0 $w data
  353.     
  354.     return [expr ($color * $data(colorbarWidth)/ $data(intensityIncr))]
  355. }
  356.  
  357.  
  358. # tkColorDialog_DrawColorScale --
  359. # 
  360. #    Draw color scale is called whenever the size of one of the color
  361. #    scale canvases is changed.
  362. #
  363. proc tkColorDialog_DrawColorScale {w c {create 0}} {
  364.     global lines
  365.     upvar #0 $w data
  366.  
  367.     # col: color bar canvas
  368.     # sel: selector canvas
  369.     set col $data($c,col)
  370.     set sel $data($c,sel)
  371.  
  372.     # First handle the case that we are creating everything for the first time.
  373.     if $create {
  374.     # First remove all the lines that already exist.
  375.     if { $data(lines,$c,last) > $data(lines,$c,start)} {
  376.         for {set i $data(lines,$c,start)} \
  377.         {$i <= $data(lines,$c,last)} { incr i} {
  378.         $sel delete $i
  379.         }
  380.     }
  381.     # Delete the selector if it exists
  382.     if [info exists data($c,index)] {
  383.         $sel delete $data($c,index)
  384.     }
  385.     
  386.     # Draw the selection polygons
  387.     tkColorDialog_CreateSelector $w $sel $c
  388.     $sel bind $data($c,index) <ButtonPress-1> \
  389.         "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
  390.     $sel bind $data($c,index) <B1-Motion> \
  391.         "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
  392.     $sel bind $data($c,index) <ButtonRelease-1> \
  393.         "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
  394.  
  395.     set height [winfo height $col]
  396.     # Create an invisible region under the colorstrip to catch mouse clicks
  397.     # that aren't on the selector.
  398.     set data($c,clickRegion) [$sel create rectangle 0 0 \
  399.         $data(canvasWidth) $height -fill {} -outline {}]
  400.  
  401.     bind $col <ButtonPress-1> \
  402.         "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
  403.     bind $col <B1-Motion> \
  404.         "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
  405.     bind $col <ButtonRelease-1> \
  406.         "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
  407.  
  408.     $sel bind $data($c,clickRegion) <ButtonPress-1> \
  409.         "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
  410.     $sel bind $data($c,clickRegion) <B1-Motion> \
  411.         "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
  412.     $sel bind $data($c,clickRegion) <ButtonRelease-1> \
  413.         "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
  414.     } else {
  415.     # l is the canvas index of the first colorbar.
  416.     set l $data(lines,$c,start)
  417.     }
  418.     
  419.     # Draw the color bars.
  420.     set highlightW [expr \
  421.     [$col cget -highlightthickness] + [$col cget -bd]]
  422.     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
  423.     set intensity [expr $i * $data(intensityIncr)]
  424.     set startx [expr $i * $data(colorbarWidth) + $highlightW]
  425.     if { $c == "red" } {
  426.         set color [format "#%02x%02x%02x" \
  427.                $intensity \
  428.                $data(green,intensity) \
  429.                $data(blue,intensity)]
  430.     } elseif { $c == "green" } {
  431.         set color [format "#%02x%02x%02x" \
  432.                $data(red,intensity) \
  433.                $intensity \
  434.                $data(blue,intensity)]
  435.     } else {
  436.         set color [format "#%02x%02x%02x" \
  437.                $data(red,intensity) \
  438.                $data(green,intensity) \
  439.                $intensity]
  440.     }
  441.  
  442.     if $create {
  443.         set index [$col create rect $startx $highlightW \
  444.         [expr $startx +$data(colorbarWidth)] \
  445.         [expr [winfo height $col] + $highlightW]\
  446.             -fill $color -outline $color]
  447.     } else {
  448.         $col itemconf $l -fill $color -outline $color
  449.         incr l
  450.     }
  451.     }
  452.     $sel raise $data($c,index)
  453.  
  454.     if $create {
  455.     set data(lines,$c,last) $index
  456.     set data(lines,$c,start) [expr $index - $data(NUM_COLORBARS) + 1 ]
  457.     }
  458.  
  459.     tkColorDialog_RedrawFinalColor $w
  460. }
  461.  
  462. # tkColorDialog_CreateSelector --
  463. #
  464. #    Creates and draws the selector polygon at the position
  465. #    $data($c,intensity).
  466. #
  467. proc tkColorDialog_CreateSelector {w sel c } {
  468.     upvar #0 $w data
  469.     set data($c,index) [$sel create polygon \
  470.     0 $data(PLGN_HEIGHT) \
  471.     $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
  472.     $data(indent) 0]
  473.     set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
  474.     $sel move $data($c,index) $data($c,x) 0
  475. }
  476.  
  477. # tkColorDialog_RedrawFinalColor
  478. #
  479. #    Combines the intensities of the three colors into the final color
  480. #
  481. proc tkColorDialog_RedrawFinalColor {w} {
  482.     upvar #0 $w data
  483.  
  484.     set color [format "#%02x%02x%02x" $data(red,intensity) \
  485.     $data(green,intensity) $data(blue,intensity)]
  486.     
  487.     $data(finalCanvas) conf -bg $color
  488.     set data(finalColor) $color
  489.     set data(selection) $color
  490.     set data(finalRGB) [list \
  491.     $data(red,intensity) \
  492.     $data(green,intensity) \
  493.     $data(blue,intensity)]
  494. }
  495.  
  496. # tkColorDialog_RedrawColorBars --
  497. #
  498. # Only redraws the colors on the color strips that were not manipulated.
  499. # Params: color of colorstrip that changed. If color is not [red|green|blue]
  500. #         Then all colorstrips will be updated
  501. #
  502. proc tkColorDialog_RedrawColorBars {w colorChanged} {
  503.     upvar #0 $w data
  504.  
  505.     switch $colorChanged {
  506.     red { 
  507.         tkColorDialog_DrawColorScale $w green
  508.         tkColorDialog_DrawColorScale $w blue
  509.     }
  510.     green {
  511.         tkColorDialog_DrawColorScale $w red
  512.         tkColorDialog_DrawColorScale $w blue
  513.     }
  514.     blue {
  515.         tkColorDialog_DrawColorScale $w red
  516.         tkColorDialog_DrawColorScale $w green
  517.     }
  518.     default {
  519.         tkColorDialog_DrawColorScale $w red
  520.         tkColorDialog_DrawColorScale $w green
  521.         tkColorDialog_DrawColorScale $w blue
  522.     }
  523.     }
  524.     tkColorDialog_RedrawFinalColor $w
  525. }
  526.  
  527. #----------------------------------------------------------------------
  528. #            Event handlers
  529. #----------------------------------------------------------------------
  530.  
  531. # tkColorDialog_StartMove --
  532. #
  533. #    Handles a mousedown button event over the selector polygon.
  534. #    Adds the bindings for moving the mouse while the button is
  535. #    pressed.  Sets the binding for the button-release event.
  536. # 
  537. # Params: sel is the selector canvas window, color is the color of the strip.
  538. #
  539. proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
  540.     upvar #0 $w data
  541.  
  542.     if !$dontMove {
  543.     tkColorDialog_MoveSelector $w $sel $color $x $delta
  544.     }
  545. }
  546.  
  547. # tkColorDialog_MoveSelector --
  548. # 
  549. # Moves the polygon selector so that its middle point has the same
  550. # x value as the specified x. If x is outside the bounds [0,255],
  551. # the selector is set to the closest endpoint.
  552. #
  553. # Params: sel is the selector canvas, c is [red|green|blue]
  554. #         x is a x-coordinate.
  555. #
  556. proc tkColorDialog_MoveSelector {w sel color x delta} {
  557.     upvar #0 $w data
  558.  
  559.     incr x -$delta
  560.  
  561.     if { $x < 0 } {
  562.     set x 0
  563.     } elseif { $x >= $data(BARS_WIDTH)} {
  564.     set x [expr $data(BARS_WIDTH) - 1]
  565.     }
  566.     set diff [expr  $x - $data($color,x)]
  567.     $sel move $data($color,index) $diff 0
  568.     set data($color,x) [expr $data($color,x) + $diff]
  569.     
  570.     # Return the x value that it was actually set at
  571.     return $x
  572. }
  573.  
  574. # tkColorDialog_ReleaseMouse
  575. #
  576. # Removes mouse tracking bindings, updates the colorbars.
  577. #
  578. # Params: sel is the selector canvas, color is the color of the strip,
  579. #         x is the x-coord of the mouse.
  580. #
  581. proc tkColorDialog_ReleaseMouse {w sel color x delta} {
  582.     upvar #0 $w data 
  583.  
  584.     set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
  585.     
  586.     # Determine exactly what color we are looking at.
  587.     set data($color,intensity) [tkColorDialog_XToRgb $w $x]
  588.  
  589.     tkColorDialog_RedrawColorBars $w $color
  590. }
  591.  
  592. # tkColorDialog_ResizeColorbars --
  593. #
  594. #    Completely redraws the colorbars, including resizing the
  595. #    colorstrips
  596. #
  597. proc tkColorDialog_ResizeColorBars {w} {
  598.     upvar #0 $w data
  599.     
  600.     if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
  601.      (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
  602.     set data(BARS_WIDTH) $data(NUM_COLORBARS)
  603.     }
  604.     tkColorDialog_InitValues $w
  605.     foreach color { red green blue } {
  606.     $data($color,col) conf -width $data(canvasWidth)
  607.     tkColorDialog_DrawColorScale $w $color 1
  608.     }
  609. }
  610.  
  611. # tkColorDialog_HandleSelEntry --
  612. #
  613. #    Handles the return keypress event in the "Selection:" entry
  614. #
  615. proc tkColorDialog_HandleSelEntry {w} {
  616.     upvar #0 $w data
  617.  
  618.     set text [string trim $data(selection)]
  619.     # Check to make sure that the color is valid
  620.     if [catch {set color [winfo rgb . $text]} ] {
  621.     set data(selection) $data(finalColor)
  622.     return
  623.     }
  624.     
  625.     set R [expr [lindex $color 0]/0x100]
  626.     set G [expr [lindex $color 1]/0x100]
  627.     set B [expr [lindex $color 2]/0x100]
  628.  
  629.     tkColorDialog_SetRGBValue $w "$R $G $B"
  630.     set data(selection) $text
  631. }
  632.  
  633. # tkColorDialog_HandleRGBEntry --
  634. #
  635. #    Handles the return keypress event in the R, G or B entry
  636. #
  637. proc tkColorDialog_HandleRGBEntry {w} {
  638.     upvar #0 $w data
  639.  
  640.     foreach c {red green blue} {
  641.     if [catch {
  642.         set data($c,intensity) [expr int($data($c,intensity))]
  643.     }] {
  644.         set data($c,intensity) 0
  645.     }
  646.  
  647.     if {$data($c,intensity) < 0} {
  648.         set data($c,intensity) 0
  649.     }
  650.     if {$data($c,intensity) > 255} {
  651.         set data($c,intensity) 255
  652.     }
  653.     }
  654.  
  655.     tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
  656.     $data(blue,intensity)"
  657. }    
  658.  
  659. # mouse cursor enters a color bar
  660. #
  661. proc tkColorDialog_EnterColorBar {w color} {
  662.     upvar #0 $w data
  663.  
  664.     $data($color,sel) itemconfig $data($color,index) -fill red
  665. }
  666.  
  667. # mouse leaves enters a color bar
  668. #
  669. proc tkColorDialog_LeaveColorBar {w color} {
  670.     upvar #0 $w data
  671.  
  672.     $data($color,sel) itemconfig $data($color,index) -fill black
  673. }
  674.  
  675. # user hits OK button
  676. #
  677. proc tkColorDialog_OkCmd {w} {
  678.     global tkPriv
  679.     upvar #0 $w data
  680.  
  681.     set tkPriv(selectColor) $data(finalColor)
  682. }
  683.  
  684. # user hits Cancel button
  685. #
  686. proc tkColorDialog_CancelCmd {w} {
  687.     global tkPriv
  688.  
  689.     set tkPriv(selectColor) ""
  690. }
  691.  
  692.